home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / PROGRAMM / PASCAL / 1463.ZIP / DRAW-2D.ARC / XLATE.PAS < prev    next >
Pascal/Delphi Source File  |  1986-12-03  |  5KB  |  130 lines
  1. PROCEDURE XLATE;
  2.    VAR
  3.      DELX,DELY:REAL;
  4.      FLAG:BOOLEAN;
  5.      KODE,K:INTEGER;
  6.    BEGIN
  7.      MOVCUR(24,2);
  8.      WRITE('Select Reference Point & press Left button >');
  9.      RING(1);
  10.      FLAG := FALSE;
  11.      WHILE NOT(FLAG) DO
  12.        BEGIN
  13.         GETMOUSE(X,Y,PIXX,PIXY,OPTION);
  14.         IF BUTTON1 THEN FLAG := TRUE;
  15.         IF (BUTTON1) AND (OPTION <> 0) THEN
  16.            BEGIN
  17.              FLAG := FALSE;
  18.              RING2;
  19.              MOVCUR(24,1);
  20.              WRITE(BLKLINE);
  21.              MOVCUR(24,2);
  22.              WRITE('Move mouse cursor into graphics area!!');
  23.            END;
  24.         IF BUTTON2 THEN RING2;
  25.        END;
  26.      M1 := 2;
  27.      MOUSE(M1,M2,M3,M4);          (* HIDE MOUSE *)
  28.      MARK(PIXX,PIXY,HRCOLOR);
  29.      M1 := 1;                     (* SHOW MOUSE *)
  30.      MOUSE(M1,M2,M3,M4);
  31.      LASTX := X;
  32.      LASTY := Y;
  33.      MOVCUR(24,1);
  34.      WRITE(BLKLINE);
  35.      MOVCUR(24,2);
  36.      WRITE('Select New Point & press Left button (Right button to Cancel) >');
  37.      RING(1);
  38.      FLAG := FALSE;
  39.      WHILE NOT(FLAG) DO
  40.         BEGIN
  41.           GETMOUSE(X,Y,PIXX,PIXY,OPTION);
  42.           IF (BUTTON1) OR (BUTTON2) THEN FLAG := TRUE;
  43.           IF (BUTTON1) AND (OPTION <> 0) THEN
  44.            BEGIN
  45.              FLAG := FALSE;
  46.              RING2;
  47.              MOVCUR(24,1);
  48.              WRITE(BLKLINE);
  49.              MOVCUR(24,2);
  50.              WRITE('Move mouse cursor into graphics area!!');
  51.            END;
  52.         END;
  53.      MOVCUR(24,1);
  54.      WRITE(BLKLINE);
  55.      IF BUTTON1 THEN
  56.         BEGIN
  57.           DELX := X - LASTX;
  58.           DELY := Y - LASTY;
  59.           PUSHID(KODE);
  60.           TRANSLAT(DELX,DELY,KODE);
  61.           CASE MNUM OF
  62.           1: BEGIN         (* ENTIRE DRAWING *)
  63.              FOR K := 1 TO OBJPTR-1 DO
  64.              WITH DRAWARY[K] DO
  65.               BEGIN
  66.                CASE OBJTYP OF
  67.             1: MODVEC(X1,Y1,STKMAT[STKPTR-1]);      (*  POINT  *)
  68.             2: BEGIN                                (*  LINE   *)
  69.                  MODVEC(X1,Y1,STKMAT[STKPTR-1]);
  70.                  MODVEC(X2,Y2,STKMAT[STKPTR-1]);
  71.                END;
  72.             3: BEGIN                                (*  BOX  *)
  73.                  MODVEC(X1,Y1,STKMAT[STKPTR-1]);
  74.                  MODVEC(X2,Y2,STKMAT[STKPTR-1]);
  75.                  MODVEC(X3,Y3,STKMAT[STKPTR-1]);
  76.                END;
  77.             4: MODVEC(X1,Y1,STKMAT[STKPTR-1]);      (* CIRCLE *)
  78.                  (* radius does not change *)
  79.                END; (* CASE *)
  80.               END; (*WITH*)
  81.              END;
  82.           2: BEGIN         (* AREA *)
  83.              FOR K := 1 TO OBJPTR-1 DO
  84.              WITH DRAWARY[K] DO
  85.               BEGIN
  86.                IF OBJSEL = 1 THEN
  87.                CASE OBJTYP OF
  88.             1: MODVEC(X1,Y1,STKMAT[STKPTR-1]);      (*  POINT  *)
  89.             2: BEGIN                                (*  LINE   *)
  90.                  MODVEC(X1,Y1,STKMAT[STKPTR-1]);
  91.                  MODVEC(X2,Y2,STKMAT[STKPTR-1]);
  92.                END;
  93.             3: BEGIN                                (*  BOX  *)
  94.                  MODVEC(X1,Y1,STKMAT[STKPTR-1]);
  95.                  MODVEC(X2,Y2,STKMAT[STKPTR-1]);
  96.                  MODVEC(X3,Y3,STKMAT[STKPTR-1]);
  97.                END;
  98.             4: MODVEC(X1,Y1,STKMAT[STKPTR-1]);      (* CIRCLE *)
  99.                  (* radius does not change *)
  100.                END; (* CASE *)
  101.               END; (*WITH*)
  102.              END;
  103.           3: BEGIN         (* SINGLE OBJECT *)
  104.              WITH DRAWARY[SELNUM] DO
  105.               BEGIN
  106.                CASE OBJTYP OF
  107.             1: MODVEC(X1,Y1,STKMAT[STKPTR-1]);      (*  POINT  *)
  108.             2: BEGIN                                (*  LINE   *)
  109.                  MODVEC(X1,Y1,STKMAT[STKPTR-1]);
  110.                  MODVEC(X2,Y2,STKMAT[STKPTR-1]);
  111.                END;
  112.             3: BEGIN                                (*  BOX  *)
  113.                  MODVEC(X1,Y1,STKMAT[STKPTR-1]);
  114.                  MODVEC(X2,Y2,STKMAT[STKPTR-1]);
  115.                  MODVEC(X3,Y3,STKMAT[STKPTR-1]);
  116.                END;
  117.             4: MODVEC(X1,Y1,STKMAT[STKPTR-1]);      (* CIRCLE *)
  118.                  (* radius does not change *)
  119.                END; (* CASE *)
  120.               END; (*WITH*)
  121.              END;
  122.            END; (* CASE *)
  123.           POPMAT(KODE);
  124.           M1 := 2;
  125.           MOUSE(M1,M2,M3,M4);          (* HIDE MOUSE *)
  126.           REDRAW;
  127.           M1 := 1;                     (* SHOW MOUSE *)
  128.           MOUSE(M1,M2,M3,M4);
  129.         END;
  130.   END; (*PROC*)